module Game.Trubis (
  module Game.Trubis,
  module Game.Trubis.Position,
  module Game.Trubis.Field,
  module Game.Trubis.PipeSection,
  module Game.Trubis.Pipe,
) where

import Game.Trubis.Position
import Game.Trubis.Field
import Game.Trubis.PipeSection
import Game.Trubis.Pipe
import Data.Array
import Data.Word
import Data.Function
import Data.Functor
import System.Random.Stateful
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.Timer

-- * Item

data Item
  = P PipeSection
  | Bomb

rotateI :: Item -> Item
rotateI (P s) = P $ rotate s
rotateI Bomb = Bomb

-- * Stats

data Stats = Stats
  { score :: Points
  , nItems :: Word
  -- ^ The number of items fallen so far.
  }

type Points = Word64

level :: Stats -> Word
level Stats{..} = nItems `div` nItemsPerLevel

nItemsPerLevel = 50

-- * Game interface

data InputEvent
  = Move Direction
  | Drop
  | Rotate

data InputEvents = InputEvents
  { nextInputEvent :: STM InputEvent
  , flushInputEvents :: STM ()
  }

data Render = Render
  { render :: (Field, Stats) -> (Item, Position) -> IO ()
  , highlightPipe :: (Field, Stats) -> (Item, Position) -> (Pipe, Points) -> IO ()
  }

data GameConfig = GameConfig
  { startLevel :: Word
  }

-- * Game

game
  :: (StatefulGen random IO)
  => random -> GameConfig -> InputEvents -> Render -> IO (Field, Stats)
game random GameConfig{..} InputEvents{..} Render{..} =
  -- Initialize
  ( mkEmptyField ((V2 1 1), (V2 10 20))
  , Stats { score = 0, nItems = startLevel * nItemsPerLevel }
  )
  -- New item appears
  & fix \newItemAppears -> \(field, stats) -> do
    item <- chance1Of 25 >>= \case
      True -> return Bomb
      False -> P <$> uniformM random
    let pos =
          {- NOTE: Using Lens here results in completely unreadable mess
                   while not providing more type safety. -}
          let (V2 x0 _y0, V2 x1 y1) = bounds field in
          V2 ((x1 - x0 - 1) `div` 2 + x0) (y1)
    -- Skip events until now
    atomically flushInputEvents
    -- Check for game over
    if pos `blocked` field then return (field, stats)
    else do
      -- The item is falling
      ip@(item, pos) <- withPeriodicTimer (gravityPeriod stats) \timer -> do
        (item, pos) & fix \loop -> \old@(item, pos) -> do
          -- Render
          render (field, stats) (item, pos)
          -- Handle next event
          event <- atomically $
            (Left <$> nextInputEvent) `orElse`
            (Right <$> retryUntilActivated timer)
          case event of
            Left inputEvent -> case inputEvent of
              Move direction ->
                let pos' = pos ^+^ direction in
                loop $ if pos' `blocked` field
                  then old
                  else (item, pos')
              Rotate ->
                loop (rotateI item, pos)
              Drop ->
                return (item, fallPos field pos)
            Right _timerActivated ->
              let pos' = pos ^+^ down in
              if pos' `blocked` field
              then return old
              else loop (item, pos')
      -- Increase nItems
      stats <- return stats { nItems = nItems stats + 1 }
      -- Explode pipes (if any)
      (field, stats) <- case item of
        Bomb -> do
          explodePipe (field, stats) ip (pipeAt field (pos ^+^ down), 0)
        P section -> do
          field <- return $ field // [(pos, Just section)]
          let pipe = pipeAt field pos
          if not (pipe & closed) then return (field, stats)
          else do
            let reward =
                  let pipeLength = fromIntegral $ length $ positions pipe in
                  let level' = fromIntegral $ level stats in
                  level' * pipeLength
            explodePipe (field, stats) ip (pipe, reward)
      -- Repeat
      newItemAppears (field, stats)
 where
  gravityPeriod stats =
    let level' = fromIntegral $ level stats :: Double in
    round (1_000_000 * (2/3) ** (level' - 1))
  chance1Of n = uniformRM (1 :: Word, n) random <&> (== 1)
  explodePipe (field, stats) ip (pipe, reward) = do
    let stats' = stats { score = score stats + reward }
    highlightPipe (field, stats') ip (pipe, reward) >> threadDelay 900_000
    return (field \\ positions pipe, stats')

